REM > Director:Menus.System.FontMenu
REM   Lenny: 19 Feb 2002
:
ON ERROR PROCerror:END
SYS "OS_GetEnv" TO in$
family$=FNarg(in$,"-family","")
DIM name 256

Menu%=FNswi_number("Director_Menu")
Endmenu%=FNswi_number("Director_EndMenu")
Option%=FNswi_number("Director_Option")
Command%=FNswi_number("Director_Command")
REM Dash%=FNswi_number("Director_Dash")

SYS "Wimp_ReadSysInfo",8 TO dtopfont%
tickfamily$="":tickface$=""
IF dtopfont%<>0 THEN
 SYS "Font_ReadDefn",dtopfont%,name
 PROCsplit($name,tickfamily$,tickface$)
ENDIF

IF family$="" menu$="FontList" ELSE menu$=family$
SYS Menu%,menu$+" -temp"
font=0
last$=""
ws=0
f$="":w$=""

REM System Font
IF family$="" THEN
 IF dtopfont%=0 THEN
  SYS Option%,"-tick SystemFont"
 ELSE
  SYS Option%,"SystemFont"
 ENDIF
 SYS Command%,"/Director:Menus.System.DoDeskFont -font SystemFont"
ENDIF

REPEAT
 SYS "Font_ListFonts",,name,font OR (%101<<16),256 TO ,,font
 IF font<>-1 THEN
  font$=$name
  tick$=""
  PROCsplit(font$,f$,w$)
  IF family$="" AND font$<>"WIMPSymbol" THEN
   IF f$<>last$ THEN
    IF f$=tickfamily$ THEN tick$=" -tick"
    SYS Option%,CHR$(34)+f$+CHR$(34)+tick$+" -sub ""Dynamic:Run Director:Menus.System.Fontmenu -family "+f$+""""
    last$=f$
   ENDIF
  ELSE
   IF family$=f$ THEN
    IF w$="" w$="(Regular)"
    IF w$=tickface$ AND family$=tickfamily$ THEN tick$=" -tick"
    SYS Option%,""""+w$+""""+tick$
    SYS Command%,"/Director:Menus.System.DoDeskFont -font "+font$
    ws+=1
   ENDIF
  ENDIF
 ENDIF
UNTIL font=-1
IF family$<>"" AND ws=0 THEN
 SYS Option%,"""(Regular)"""
 SYS Command%,"/Director:Menus.System.DoDeskFont -font "+family$
ENDIF
SYS Endmenu%
OSCLI "*Set Director$Menu "+menu$
END

DEF FNarg(str$,arg$,def$)
 LOCAL i,j
 i=INSTR(str$,arg$)
 IF i=0 THEN =def$
 i+=LEN arg$+1
 j=INSTR(str$+" <"," ",i)
=MID$(str$,i,j-i)

DEF FNswi_number(swi$)
 SYS "OS_SWINumberFromString",,swi$ TO swi%
=swi%

DEF FNc(n)
=RIGHT$("    "+STR$ n,4)

DEF PROCsplit(font$,RETURN f1$,RETURN f2$)
 LOCAL dot%
 dot%=INSTR(font$,".")
 IF dot%<>0 THEN
  f1$=LEFT$(font$,dot%-1)
  f2$=MID$(font$,dot%+1)
 ELSE
  f1$=font$
  f2$=""
 ENDIF
ENDPROC
:
DEF PROCerror
 ON ERROR OFF
 VDU 4
 PRINT "Error in: !Director.Menus.System.FontMenu"
 PRINT "Report:   ";REPORT$
 PRINT "Line:     ";ERL
ENDPROC
